unit XmlInterpreter ;

{$B-}

interface

uses
   SysUtils,
   Contnrs ;

type
   // Forward declaration of base visitor class
   TXmlInterpreterVisitor = class ;

   // Abstract base expression class
   TXmlExpression = class( TObject )
   private
   protected
      function DoSearchAndReplace( const TargetStr, SearchStr, ReplaceStr : string ) : string ;
   public
      // Declaring these methods abstract forces descendant classes to implement them
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; virtual ; abstract ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; virtual ; abstract ;
   end ;

   TXmlStartTag = class( TXmlExpression )
   private
      FTagName : string ;
   protected
   public
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property TagName : string read FTagName write FTagName ;
   end ;

   TXmlEndTag = class( TXmlExpression )
   private
      FTagName : string ;
   protected
   public
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property TagName : string read FTagName write FTagName ;
   end ;

   TXmlTagList = class ;

   TXmlNode = class( TXmlExpression )
   private
      FStartTag : TXmlStartTag ;
      FData : string ;
      FTagList : TXmlTagList ;
      FEndTag : TXmlEndTag ;
   public
      destructor Destroy ; override ;

      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property StartTag : TXmlStartTag read FStartTag write FStartTag ;
      property EndTag : TXmlEndTag read FEndTag write FEndTag ;
      property Data : string read FData write FData ;
      property TagList : TXmlTagList read FTagList write FTagList ;
   end ;

   TXmlTagList = class( TXmlExpression )
   private
      FList : TObjectList ;

      function GetItem( Index : Integer ) : TXmlNode ;
   protected
   public
      constructor Create ;
      destructor Destroy ; override ;

      function Add : TXmlNode ;
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property Items[ Index : Integer ] : TXmlNode read GetItem ; default ;
   end ;

   TXmlProlog = class( TXmlExpression )
   private
      FData : string ;
   protected
   public
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property Data : string read FData write FData ;
   end ;

   TXmlDoc = class( TXmlExpression )
   private
      FProlog : TXmlProlog ;
      FTagList : TXmlTagList ;
   protected
   public
      destructor Destroy ; override ;

      procedure Clear ;
      procedure SearchAndReplace( const SearchStr, ReplaceStr : string ;
         DoTags : Boolean = False ) ; override ;
      procedure Accept( Visitor : TxmlInterpreterVisitor ) ; override ;

      property Prolog : TXmlProlog read FProlog write FProlog ;
      property TagList : TXmlTagList read FTagList write FTagList ;
   end ;

   // Equates to Client in the Interpreter pattern
   TXmlInterpreter = class( TObject )
   private
      FXmlDoc : TXmlDoc ;
   protected
   public
      constructor Create ;
      destructor Destroy ; override ;

      property XmlDoc : TXmlDoc read FXmlDoc write FXmlDoc ;
   end ;

   // Base visitor class
   TXmlInterpreterVisitor = class( TObject )
   private
   protected
      // Visit methods are virtual so that visitor descendants can choose
      // which methods to implement - it may not be necessary to implement them all
      procedure Visit( Exp : TXmlStartTag ) ; overload ; virtual ;
      procedure Visit( Exp : TXmlEndTag ) ; overload ; virtual ;
      procedure Visit( Exp : TXmlNode ) ; overload ; virtual ;
      procedure Visit( Exp : TXmlTagList ) ; overload ; virtual ;
      procedure Visit( Exp : TXmlProlog ) ; overload ; virtual ;
      procedure Visit( Exp : TXmlDoc ) ; overload ; virtual ;
   public
   end ;

   EXmlInterpreterError = class( Exception ) ;

implementation

uses
   Classes ;

{ TXmlExpression }

function TXmlExpression.DoSearchAndReplace( const TargetStr, SearchStr, ReplaceStr : string ) : string ;
begin
   Result := StringReplace( TargetStr, SearchStr, ReplaceStr, [ rfReplaceAll, rfIgnoreCase ] ) ;
end ;

{ TXmlStartTag }

procedure TXmlStartTag.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
begin
   if not DoTags then begin
      Exit ;
   end ;

   TagName := DoSearchAndReplace( TagName, SearchStr, ReplaceStr ) ;
end ;

procedure TXmlStartTag.Accept( Visitor : TxmlInterpreterVisitor ) ;
begin
   Visitor.Visit( Self ) ;
end ;

{ TXmlEndTag }

procedure TXmlEndTag.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
begin
   if not DoTags then begin
      Exit ;
   end ;

   TagName := DoSearchAndReplace( TagName, SearchStr, ReplaceStr ) ;
end ;

procedure TXmlEndTag.Accept( Visitor : TxmlInterpreterVisitor ) ;
begin
   Visitor.Visit( Self ) ;
end ;

{ TXmlNode }

destructor TXmlNode.Destroy ;
begin
   FStartTag.Free ;
   FEndTag.Free ;
   FTagList.Free ;
   inherited ;
end ;

procedure TXmlNode.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
begin
   if Assigned( StartTag ) then begin
      StartTag.SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end ;

   // Since have either a taglist, or data, just search one
   if Assigned( TagList ) then begin
      TagList.SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end
   else begin
      Data := DoSearchAndReplace( Data, SearchStr, ReplaceStr ) ;
   end ;

   if Assigned( EndTag ) then begin
      EndTag.SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end ;
end ;

procedure TXmlNode.Accept( Visitor : TxmlInterpreterVisitor ) ;
begin
   if Assigned( TagList ) then begin
      // Visit the tags separately
      if Assigned( StartTag ) then begin
         StartTag.Accept( Visitor ) ;
      end ;

      TagList.Accept( Visitor ) ;

      if Assigned( EndTag ) then begin
         EndTag.Accept( Visitor ) ;
      end ;
   end
   else begin
      // Just visit this (data) node, as can get at the tags from Self
      // Mainly done differently than SearchAndReplace above to make the
      // pretty-printer easier to code.
      Visitor.Visit( Self ) ;
   end ;
end ;

{ TXmlTagList }

constructor TXmlTagList.Create ;
begin
   FList := TObjectList.Create( True ) ; // So list manages memory
end ;

destructor TXmlTagList.Destroy ;
begin
   FList.Free ;
   inherited ;
end ;

function TXmlTagList.Add : TXmlNode ;
begin
   Result := TXmlNode.Create ;
   FList.Add( Result ) ;
end ;

function TXmlTagList.GetItem( Index : Integer ) : TXmlNode ;
begin
   Result := nil ;

   if ( Index >= 0 ) and ( Index < FList.Count ) then begin
      Result := TXmlNode( FList[ Index ] ) ;
   end ;
end ;

procedure TXmlTagList.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
var
   i                : Integer ;
begin
   for i := 0 to FList.Count - 1 do begin
      Items[ i ].SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end ;
end ;

procedure TXmlTagList.Accept( Visitor : TxmlInterpreterVisitor ) ;
var
   i                : Integer ;
begin
   Visitor.Visit( Self ) ;

   for i := 0 to FList.Count - 1 do begin
      Items[ i ].Accept( Visitor ) ;
   end ;
end ;

{ TXmlProlog }

procedure TXmlProlog.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
begin
   Data := DoSearchAndReplace( Data, SearchStr, ReplaceStr ) ;
end ;

procedure TXmlProlog.Accept( Visitor : TxmlInterpreterVisitor ) ;
begin
   Visitor.Visit( Self ) ;
end ;

{ TXmlDoc }

destructor TXmlDoc.Destroy ;
begin
   FProlog.Free ;
   FTagList.Free ;
   inherited ;
end ;

procedure TXmlDoc.Clear ;
begin
   FProlog.Free ;
   FTagList.Free ;
end ;

procedure TXmlDoc.SearchAndReplace( const SearchStr, ReplaceStr : string ;
   DoTags : Boolean ) ;
begin
   if Assigned( Prolog ) then begin
      Prolog.SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end ;

   if Assigned( TagList ) then begin
      TagList.SearchAndReplace( SearchStr, ReplaceStr, DoTags ) ;
   end ;
end ;

procedure TXmlDoc.Accept( Visitor : TxmlInterpreterVisitor ) ;
begin
   Visitor.Visit( Self ) ;

   if Assigned( Prolog ) then begin
      Prolog.Accept( Visitor ) ;
   end ;

   if Assigned( TagList ) then begin
      TagList.Accept( Visitor ) ;
   end ;
end ;

{ TXmlInterpreter }

constructor TXmlInterpreter.Create ;
begin
   inherited ;
   FXmlDoc := TXmlDoc.Create ;
end ;

destructor TXmlInterpreter.Destroy ;
begin
   FXmlDoc.Free ;
   inherited ;
end ;

{ TXmlInterpreterVisitor }

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlStartTag ) ;
begin

end ;

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlEndTag ) ;
begin

end ;

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlNode ) ;
begin

end ;

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlTagList ) ;
begin

end ;

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlProlog ) ;
begin

end ;

procedure TXmlInterpreterVisitor.Visit( Exp : TXmlDoc ) ;
begin

end ;

end.

